home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / tests / process.test < prev    next >
Encoding:
Text File  |  1993-10-26  |  3.7 KB  |  128 lines  |  [TEXT/MPS ]

  1. #
  2. # process.test
  3. #
  4. # Tests for the fork, execl and  wait commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: process.test,v 2.5 1993/08/03 06:50:36 markd Exp $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Proc to fork and exec child that loops until it gets a signal.  If pgroup
  22. # is set, a file is created to indicate its been done.  This lets the 
  23. # parent sync up with the child.
  24.  
  25. proc ForkLoopingChild {{setPGroup 0}} {
  26.     unlink -nocomplain {PGROUP.SET}
  27.     flush stdout
  28.     flush stderr
  29.     set newPid [fork]
  30.     if {$newPid != 0} {
  31.         if $setPGroup {
  32.             while {![file exists PGROUP.SET]} {
  33.                 sleep 1
  34.             }
  35.         }
  36.         return $newPid
  37.     }
  38.     if $setPGroup {
  39.         id process group set
  40.         close [open PGROUP.SET w]
  41.     }
  42.     execl ../tclmaster/bin/tcl {-qc {catch {while {1} {sleep 1}}; exit 10}}
  43.     error "Should never make it here"
  44. }
  45.  
  46.  
  47. # Test fork, execl, and wait commands.
  48.  
  49. Test process-1.1 {fork, execl, wait tests} {
  50.     set newPid [fork]
  51.     if {$newPid == 0} {
  52.         execl ../tclmaster/bin/tcl {-qc {sleep 1;exit 12}}
  53.         error "Should never make it here"
  54.     }
  55.     lrange [wait $newPid] 1 end
  56. } 0 {EXIT 12}
  57.  
  58. Test process-1.2 {fork, execl, wait tests} {
  59.     set newPid [ForkLoopingChild]
  60.     sleep 1
  61.  
  62.     kill $newPid
  63.     lrange [wait $newPid] 1 end
  64. } 0 {SIG SIGTERM}
  65.  
  66. set newPid1 [ForkLoopingChild]
  67. set newPid2 [ForkLoopingChild]
  68.  
  69. Test process-1.3 {fork, execl, wait tests} {
  70.     sleep 3 ;# Give em a chance to get going.
  71.  
  72.     kill [list $newPid1 $newPid2]
  73.  
  74.     list [wait $newPid1] [wait $newPid2]
  75.  
  76. } 0 [list "$newPid1 SIG SIGTERM" "$newPid2 SIG SIGTERM"]
  77.  
  78. Test process-1.4 {fork, execl, wait tests} {
  79.     fork foo
  80. } 1 {wrong # args: fork}
  81.  
  82. Test process-1.5 {fork, execl, wait tests} {
  83.     wait baz
  84. } 1 {invalid pid or process group id "baz"}
  85.  
  86. Test process-1.6 {fork, execl, wait tests} {
  87.     set testPid [ForkLoopingChild]
  88.     kill $testPid
  89.     set result [wait $testPid]
  90.     lrange $result 1 end
  91. } 0 {SIG SIGTERM}
  92.  
  93. # Test extended wait functionality, if available.
  94.  
  95. catch {wait -nohang 1} result
  96. if [string match "The \"-nohang\", \"-untraced\"*" $result] {
  97.     echo *** Extended wait functionallity not available on this system"
  98.     echo *** Skipping the remainder of the process tests"
  99.     return
  100. }
  101.  
  102. Test process-2.1 {fork, execl, wait tests} {
  103.     set testPid [ForkLoopingChild]
  104.     set result1 [wait -nohang $testPid]
  105.     kill $testPid
  106.     set result2 [wait $testPid]
  107.     list $result1 [lrange $result2 1 end]
  108. } 0 {{} {SIG SIGTERM}}
  109.  
  110. Test process-2.2 {fork, execl, wait tests} {
  111.     set testPid [ForkLoopingChild 1]
  112.     set result1 [wait -nohang -pgroup $testPid]
  113.     kill $testPid
  114.     set result2 [wait -pgroup $testPid]
  115.     list $result1 [lrange $result2 1 end]
  116. } 0 {{} {SIG SIGTERM}}
  117.  
  118. Test process-2.3 {fork, execl, wait tests} {
  119.     set testPid [ForkLoopingChild 1]
  120.     set result1 [wait -nohang -pgroup -untraced $testPid]
  121.     kill $testPid
  122.     set result2 [wait -pgroup -untraced $testPid]
  123.     list $result1 [lrange $result2 1 end]
  124. } 0 {{} {SIG SIGTERM}}
  125.  
  126.  
  127. unlink -nocomplain {PGROUP.SET}
  128.